home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BMUG Revelations
/
BMUG Revelations.toast
/
Programming
/
Programming Languages
/
Yerk 3.64
/
Module source
/
Tool
< prev
next >
Wrap
Text File
|
1993-04-29
|
6KB
|
243 lines
\ Construct table of names & traps for toolbox calls
\ Modification History
\ 4/23/84 CBD Version 1.0
\ 12/29/85 cdn Improved asmCall to accept upper/lower case
\ 6/11/86 cdn Added Mac Plus toolbox calls; generally improved code
\ 6/28/86 cdn Added call Pack routines by name
\ 7/01/86 ndc Added hash collision resolution
\ 8/28/86 cdn Added fcall
\ 9/03/86 rfd Modified Tools" for HFS compatability (no reopen)
\ 6/16/87 rfl Added calls for MacII
\ 8/28/88 rfl increased collision table to 10 bytes because of
\ confusion with dispospixmap and dispospixpat ETC.
\ Make sure to vary name,trap,parm,pibx, and ctable sizes
\ Also, all traps must be in one text file to be read in
\ 8/31/88 rfl changed allot to reserve to fix error in modulation
\ the second pass must equal the first pass in data errors
\ or else the module code will figure the difference is an addr
\ which must be relocated
\ 9/19/88 rfl added popupmenu traps
\ 10/07/89 rfl increase to 1000 and 120
\ 8/13/90 rfl modify sizes
\ 12/15/90 rfl moved gtool here
\ 2/07/91 rfl increased globals
\ 2/17/91 rfl modified for use with Michael Hore's 32bit hash routine.
\ collisions are VERY rare.
\ 7/02/91 rfl allow hex values for parms
\ 10/25/91 rfl fixed occasional bug in hex value code
Decimal
:Module Tool
:CLASS wArray <Super Object 2 <Indexed
:M AT: ?idx ^Elem w@ ;M
:M TO: ?idx ^Elem w! ;M
;CLASS
:CLASS wordCol <Super wArray
Int Size \ # elements in list
\ ( -- curSize ) Return #elements currently in list
:M SIZE: Get: Size ;M
\ ( val -- ) Add value to end of list
:M ADD: Get: Size limit >=
classErr" 137 Get: size To: Self
1 +: Size ;M
\ ( val -- ind t OR f) Find a value in an OC
:M INDEXOF: 0 swap Get: Size 0
DO i (^elem) w@
over = IF 2drop i 1 1 leave THEN
LOOP drop ;M
;CLASS
1500 ordered-Col Names
1500 wordCol Traps
500 wordCol pIdx
500 wordCol Parms
hex
\ ( addr -- hashVal ) hash a name into a 32-bit word
create HashName
2057 w, \ move.l (sp),a0
d1cb w, \ adda.l a3,a0
7000 w, \ moveq #0,d0 \ Result will go to D0
7400 w, \ moveq #0,d2
1418 w, \ move.b (a0)+,d2 \ Count
c43c007f , \ and.b #127,d2 \ Clear top bit in case it's a name field
60000008 , \ bra lptest
ef98 w, \ loop rol.l #7,d0
1218 w, \ move.b (a0)+,d1
b300 w, \ eor.b d1,d0 \ b300
51cafff8 , \ lptest dbra d2,loop
08c0001f , \ bset #31,d0
2e80 w, \ move.l d0,(sp)
next,
decimal
( str255 chr -- offs t OR f )
: charOf { adr chr -- }
0 \ bool
adr c@ 1+ 1
DO
adr i+ c@ chr = IF drop i 1- 1 leave THEN
LOOP
;
0 value pstr
\ ( -- ) Get next word, add if tool name, record parm if applicable
: ToolName { \ addr trap# nhash -- }
0 -> pstr size: traps .d
@word hex number drop -> trap#
@word -> addr
addr ascii , charOf \ ignore any "," in the name
IF dup addr + 1+ -> pStr addr c! THEN
addr HashName -> nhash
nhash indexOf: names ( trap# hashval [idx] bool )
IF . abort" collison" \ mark collision item
ELSE nhash add: names trap# add: traps
THEN
pstr
IF size: names 1- add: pIdx \ now figure parms
pstr 1+ c@ ascii $ =
IF pstr 1+ hex ELSE pstr decimal THEN number drop add: parms decimal
THEN ;
\ read toolbox name/trap table and fill arrays
: Tools" { \ radix cecho -- }
base -> radix decho -> cecho
new: loadFile setName: topFile
openReadOnly: topFile ?error 149
0 moveTo: topFile drop
query: topFile drop
BEGIN \ read until eof
tib c@ ascii \ <> \ skip comments
IF ToolName THEN
query: topFile
UNTIL
-echo
remove: loadFile
radix -> base cecho -> decho ;
\ load the calls into the symbol table
Tools" ::Module source:calls.TOT
forget ToolName \ dump table generation code
CR
size: traps . ." routine names stored" CR
size: parms . ." with parameters" CR
\ ( str255 -- Trap [parm] bool ) Get Trap word for a call index
: @Trap { tStr \ mStr -- } 0 -> mStr
tStr ascii , charOf \ stop short of comma if any
IF dup tStr c! tStr + 2+ -> mStr THEN
tStr HashName indexOf: names 0= ?error 150
dup at: traps ( idx trap/flag )
mStr \ modifier bits if any
IF mStr 4 " REGS" s= IF $ 0100 or THEN \ GetTrapAddr
mStr 5 " ASYNC" s= IF $ 0400 or THEN \ device drivers
mStr 5 " IMMED" s= IF $ 0200 or THEN \ control calls
mStr 3 " SYS" s= IF $ 0400 or THEN \ Memory Manager
mStr 5 " CLEAR" s= IF $ 0200 or THEN
mStr 5 " MARKS" s= IF $ 0400 or THEN \ String Compares
mStr 4 " CASE" s= IF $ 0200 or THEN
THEN
swap indexOf: pIdx IF at: parms 1 ELSE 0 THEN \ call parms if any
;
\ ( addr len -- trap )
: AsmCall
str255 1+ buf255 c@ >uc
buf255 @Trap
IF $ 203c w, , THEN w, ; \ conditionally move parm into D0
\ Trap dispatcher
: Call
@word @Trap
State
IF IF Compile wLitw w, THEN
Compile (trap) w,
ELSE IF makeInt THEN
trap
THEN
; Immediate
\ Trap dispatcher for low-level File Manager
: fCall
@word @Trap
State
IF Compile Lit
IF ELSE 0 THEN
w, w, Compile (fdos)
ELSE IF makeInt THEN
(fdos)
THEN
; Immediate
\ ************
182 ordered-col gNames
182 wordCol globals
\ ( -- ) Get next word, add if global name
: globalName
size: globals .d
@word hex number drop ( global addr )
@word
HashName dup indexOf: gNames ( trap# hashval [idx] bool )
IF . abort" collision" \ mark collision item
ELSE add: gNames add: globals
THEN ;
\ read toolbox name/trap table and fill arrays
: Tools" { \ radix cecho -- }
base -> radix decho -> cecho
new: loadFile setName: topFile
openReadOnly: topFile ?error 149
0 moveTo: topFile drop
query: topFile drop
BEGIN \ read until eof
tib c@ ascii \ <> \ skip comments
IF globalName THEN
query: topFile
UNTIL
-echo
remove: loadFile
radix -> base cecho -> decho ;
\ load the calls into the symbol table
Tools" ::Module source:globals
forget globalName \ dump table generation code
CR
size: globals . ." routine gNames stored" CR
\ ( str255 -- global ) Get global word for a global index
: @global { tStr -- }
tStr HashName indexOf: gNames 0= ?error 150
dup ^elem: globals w@ ( idx trap/flag )
swap drop ;
\ global dispatcher
: global
@word @global
state
IF compile lit , 'c -base ,
ELSE -base
THEN
; Immediate
;Module